open Castling;;
open Ada_lexical;;

module Syntax (Integer: NumericType) (Real: NumericType)
	(LexicalElement: LexicalElementType with type integer = Integer.t and type real = Real.t) =
struct
	open LexicalElement;;
	module AdaPG = ParserGenerator (LexicalElement);;
	open AdaPG;;
	
	let l_paren = skip (element L_paren);;
	let r_paren = skip (element R_paren);;
	let semicolon = skip (element Semicolon);;
	let any_identifier = element (I ("", ""));;
	let any_enum_name = one_of_elements [I ("", ""); Character_literal "\x00"; Character_code (8, 0l); Invalid_literal];;
	let any_name = one_of_elements [I ("", ""); String_literal ""; Character_literal "\x00"; Character_code (8, 0l); Invalid_literal];;
	let any_character_literal = one_of_elements [Character_literal "\x00"; Character_code (8, 0l); Invalid_literal];;
	let any_literal = one_of_elements [Integer_literal Integer.zero; Real_literal Real.zero; String_literal ""; Character_literal "\x00"; Character_code (8, 0l); Invalid_literal];;
	let any_attribute = element (A (Attribute.Unknown ""));;
	let any_pragma = element (P (Pragma.Unknown ""));;
	let r_ABORT = skip (element (R Reserved.ABORT));;
	let r_ABS = skip (element (R Reserved.ABS));;
	let r_ABSTRACT = skip (element (R Reserved.ABSTRACT));;
	let r_ACCEPT = skip (element (R Reserved.ACCEPT));;
	let r_ACCESS = skip (element (R Reserved.ACCESS));;
	let r_ALIASED = skip (element (R Reserved.ALIASED));;
	let r_ALL = skip (element (R Reserved.ALL));;
	let r_AND = skip (element (R Reserved.AND));;
	let r_ARRAY = skip (element (R Reserved.ARRAY));;
	let r_AT = skip (element (R Reserved.AT));;
	let r_BEGIN = skip (element (R Reserved.BEGIN));;
	let r_BODY = skip (element (R Reserved.BODY));;
	let r_CASE = skip (element (R Reserved.CASE));;
	let r_CONSTANT = skip (element (R Reserved.CONSTANT));;
	let r_DECLARE = skip (element (R Reserved.DECLARE));;
	let r_DELAY = skip (element (R Reserved.DELAY));;
	let r_DELTA = skip (element (R Reserved.DELTA));;
	let r_DIGITS = skip (element (R Reserved.DIGITS));;
	let r_DO = skip (element (R Reserved.DO));;
	let r_ELSE = skip (element (R Reserved.ELSE));;
	let r_ELSIF = skip (element (R Reserved.ELSIF));;
	let r_END = skip (element (R Reserved.END));;
	let r_ENTRY = skip (element (R Reserved.ENTRY));;
	let r_EXCEPTION = skip (element (R Reserved.EXCEPTION));;
	let r_EXIT = skip (element (R Reserved.EXIT));;
	let r_FOR = skip (element (R Reserved.FOR));;
	let r_FUNCTION = skip (element (R Reserved.FUNCTION));;
	let r_GENERIC = skip (element (R Reserved.GENERIC));;
	let r_GOTO = skip (element (R Reserved.GOTO));;
	let r_IF = skip (element (R Reserved.IF));;
	let r_IN = skip (element (R Reserved.IN));;
	let r_INTERFACE = skip (element (R Reserved.INTERFACE));;
	let r_IS = skip (element (R Reserved.IS));;
	let r_LIMITED = skip (element (R Reserved.LIMITED));;
	let r_LOOP = skip (element (R Reserved.LOOP));;
	let r_MOD = skip (element (R Reserved.MOD));;
	let r_NEW = skip (element (R Reserved.NEW));;
	let r_NOT = skip (element (R Reserved.NOT));;
	let r_NULL = skip (element (R Reserved.NULL));;
	let r_OF = skip (element (R Reserved.OF));;
	let r_OR = skip (element (R Reserved.OR));;
	let r_OTHERS = skip (element (R Reserved.OTHERS));;
	let r_OUT = skip (element (R Reserved.OUT));;
	let r_OVERRIDING = skip (element (R Reserved.OVERRIDING));;
	let r_PACKAGE = skip (element (R Reserved.PACKAGE));;
	let r_PRIVATE = skip (element (R Reserved.PRIVATE));;
	let r_PROCEDURE = skip (element (R Reserved.PROCEDURE));;
	let r_PROTECTED = skip (element (R Reserved.PROTECTED));;
	let r_RAISE = skip (element (R Reserved.RAISE));;
	let r_RANGE = skip (element (R Reserved.RANGE));;
	let r_RECORD = skip (element (R Reserved.RECORD));;
	let r_REM = skip (element (R Reserved.REM));;
	let r_RENAMES = skip (element (R Reserved.RENAMES));;
	let r_REQUEUE = skip (element (R Reserved.REQUEUE));;
	let r_RETURN = skip (element (R Reserved.RETURN));;
	let r_REVERSE = skip (element (R Reserved.REVERSE));;
	let r_SELECT = skip (element (R Reserved.SELECT));;
	let r_SEPARATE = skip (element (R Reserved.SEPARATE));;
	let r_SUBTYPE = skip (element (R Reserved.SUBTYPE));;
	let r_SYNCHRONIZED = skip (element (R Reserved.SYNCHRONIZED));;
	let r_TAGGED = skip (element (R Reserved.TAGGED));;
	let r_TASK = skip (element (R Reserved.TASK));;
	let r_TERMINATE = skip (element (R Reserved.TERMINATE));;
	let r_THEN = skip (element (R Reserved.THEN));;
	let r_TYPE = skip (element (R Reserved.TYPE));;
	let r_UNTIL = skip (element (R Reserved.UNTIL));;
	let r_USE = skip (element (R Reserved.USE));;
	let r_WHEN = skip (element (R Reserved.WHEN));;
	let r_WHILE = skip (element (R Reserved.WHILE));;
	let r_WITH = skip (element (R Reserved.WITH));;
	let r_XOR = skip (element (R Reserved.XOR));;
	
	let rec compilation_units = lazy !! (
		one_of ~name:"compilation_unit_list" [
			"next_compilation_unit", compilation_unit_c >> semicolon >> compilation_units;
			"pragma_only", pragma_list;
			"end_of_compilation_unit", epsilon]
	) and compilation_unit_c = lazy !! (
		one_of ~name:"compilation_unit" [
			"", compilation_unit_v;
			"has_with_clause", with_clause >> semicolon >> compilation_unit_c;
			"has_use_clause", use_clause >> semicolon >> compilation_unit_c;
			"has_configuration_pragma", pragma >> compilation_unit_c]
	) and compilation_unit_v = lazy !! (
		one_of ~name:"compilation_unit" [
			"", compilation_unit_g;
			"private_unit", r_PRIVATE >> compilation_unit_g]
	) and compilation_unit_g = lazy !! (
		one_of ~name:"compilation_unit" [
			"", compilation_unit;
			"generic_unit", r_GENERIC >> error_pragma_list >> generic_formal_parameter_declarations >> compilation_unit;
			"subunit", subunit]
	) and compilation_unit = lazy !! (
		one_of ~name:"compilation_unit" [
			"procedure_unit", procedure_declaration;
			"function_unit", function_declaration;
			error "task_unit_error", task_declaration; (* better error handling *)
			error "protected_unit_error", protected_declaration; (* better error handling *)
			"package_unit", package_declaration]
	) and with_clause = lazy !! (
		one_of ~name:"with_clause" [
			"with", r_WITH >> packages;
			"limited_with", r_LIMITED >> r_WITH >> packages;
			"private_with", r_PRIVATE >> r_WITH >> packages;
			"limited_private_with", r_LIMITED >> r_PRIVATE >> r_WITH >> packages]
	) and use_clause = lazy !! (
		one_of ~name:"use_clause" [
			"use_type", r_USE >> r_TYPE >> primary_list;
			"use_packages", r_USE >> packages]
	) and primary_list = lazy !! (
		one_of ~name:"primaries" [
			"next_primary", primary >> skip (element Comma) >> primary_list;
			"end_of_primary", primary]
	) and packages = lazy !! (
		one_of ~name:"packages" [
			"next_package", package_name_ref >> skip (element Comma) >> packages;
			"end_of_package", package_name_ref]
	(* declarations *)
	) and procedure_declaration = lazy !! (
		sequence_of (r_PROCEDURE >> subprogram_name >> formal_list >> subprogram_impl)
	) and function_declaration = lazy !! (
		sequence_of (
			r_FUNCTION >> subprogram_name >> formal_list >>
			one_of ~name:"return" [
				"return_type", r_RETURN >> object_type;
				"return_constant", r_RETURN >> object_type >> skip (element Assign) >> expression; (* ex *)
				"return_simple_constant", skip (element EQ) >> expression; (* ex *)
				"missing_return", epsilon] >>
			subprogram_impl)
	) and subprogram_impl = lazy !! (
		one_of ~name:"subprogram" [
			"generic_subprogram_instantiation", r_IS >> r_NEW >> primary;
			"subprogram_spec", epsilon;
			"subprogram_null", r_IS >> r_NULL;
			"subprogram_separated", r_IS >> r_SEPARATE;
			"subprogram_abstract", r_IS >> r_ABSTRACT;
			"subprogram_renaming", r_RENAMES >> primary;
			"subprogram_body", r_IS >> declarations >> block >> optional_subprogram_name]
	) and private_part = lazy !! (
		one_of ~name:"private_part" [
			"no_private", epsilon;
			"has_private", r_PRIVATE >> declarations]
	) and initialization = lazy !! (
		one_of ~name:"initialization" [
			"initialization_block", block;
			"no_initialization", r_END]
	) and package_declaration = lazy !! (
		one_of ~name:"package" [
			"generic_instantiation",
				r_PACKAGE >> optional_package_name >> r_IS >> r_NEW >> primary;
			"package_spec",
				r_PACKAGE >> optional_package_name >> r_IS >>
				declarations >> private_part >>
				r_END >> optional_package_name;
			"package_renaming", r_PACKAGE >> optional_package_name >>
				r_RENAMES >> primary;
			"package_separated", r_PACKAGE >> r_BODY >> package_name >> r_IS >> r_SEPARATE;
			"package_body", r_PACKAGE >> r_BODY >> package_name >> r_IS >>
				declarations >> initialization >> optional_package_name]
	) and package_declaration_with_private = lazy !! ( (* ex *)
		one_of ~name:"package" [
			"", package_declaration;
			"generic_instantiation_with_private",
				r_PACKAGE >> optional_package_name >> r_IS >> r_NEW >> primary >>
				r_WITH >> r_PRIVATE;
			"package_spec_with_private",
				r_PACKAGE >> optional_package_name >> r_IS >>
				declarations >> private_part >>
				r_END >> optional_package_name >> r_WITH >> r_PRIVATE]
	) and task_declaration = lazy !! (
		one_of ~name:"task" [
			"task_type_forward", r_TASK >> r_TYPE >> any_identifier >> box_or_formal_list;
			"task_type", r_TASK >> r_TYPE >> any_identifier >> box_or_formal_list >> r_IS >>
				synchronized_inheritance >> declarations >> private_part >>
				initialization >> (* ex *)
				optional_name;
			"task_forward", r_TASK >> any_identifier >> box_or_formal_list;
			"task_spec", r_TASK >> any_identifier >> r_IS >> 
				synchronized_inheritance >> declarations >> private_part >>
				initialization >> (* ex *)
				optional_name;
			"task_separated", r_TASK >> r_BODY >> any_identifier >> r_IS >> r_SEPARATE;
			"task_body", r_TASK >> r_BODY >> any_identifier >> r_IS >> 
				declarations >> block >> optional_name]
	) and protected_declaration = lazy !! (
		one_of ~name:"protected" [
			"protected_type_forward", r_PROTECTED >> r_TYPE >> any_identifier >> box_or_formal_list;
			"protected_type", r_PROTECTED >> r_TYPE >> any_identifier >> box_or_formal_list >> r_IS >>
				synchronized_inheritance >> declarations >> private_part >>
				r_END >> optional_name;
			"protected_forward", r_PROTECTED >> any_identifier >> box_or_formal_list;
			"protected_spec", r_PROTECTED >> any_identifier >> r_IS >>
				synchronized_inheritance >> declarations >> private_part >>
				r_END >> optional_name;
			"protected_separated", r_PROTECTED >> r_BODY >> any_identifier >> r_IS >> r_SEPARATE;
			"protected_body", r_PROTECTED >> r_BODY >> any_identifier >> r_IS >>
				declarations >> r_END >> optional_name]
	) and entry = lazy !! (
		one_of ~name:"entry_declaration" [
			"entry_spec", r_ENTRY >> any_identifier >> index_and_formal_list;
			"entry_body", r_ENTRY >> any_identifier >> index_and_formal_list >>
				condition >> r_IS >> declarations >> block >> optional_name]
	) and condition = lazy !! ( (* entry when, exit when *)
		one_of ~name:"condition" [
			"always", epsilon;
			"when", r_WHEN >> expression]
	) and subunit = lazy !! (
		r_SEPARATE >> l_paren >> package_name >> r_paren >>
		one_of ~name:"compilation_unit" [
			"procedure_unit", procedure_declaration;
			"function_unit", function_declaration;
			"package_unit", package_declaration;
			"task_unit", task_declaration;
			"protected_unit", protected_declaration]
	) and synchronized_inheritance = lazy !! (
		one_of ~name:"inheritance" [
			"no_inheritance", epsilon;
			"", r_NEW >> inheritance >> r_WITH]
	) and identifiers = lazy !! (
		one_of ~name:"identifiers" [
			"next_identifier", any_identifier >> skip (element Comma) >> identifiers;
			"end_of_identifier", any_identifier]
	) and object_declaration = lazy !! (
		sequence_of (identifiers >> skip (element Colon) >> object_type >> object_initial)
	) and object_initial = lazy !! (
		one_of ~name:"object_initial" [
			"initial", skip (element Assign) >> expression;
			"renames", r_RENAMES >> expression;
			"no_initial", epsilon]
	) and patterns = lazy !! (
		one_of ~name:"patterns" [
			"pattern_as", any_identifier >> skip (element Colon) >> argument_names;
			"pattern_names", argument_names]
	) and variant_record_alternatives = lazy !! (
		one_of ~name:"variant_record_alternatives" [
			"next_variant", r_WHEN >> argument_names >> skip (element Arrow) >> component_list >> variant_record_alternatives;
			"end_of_variant", r_END >> r_CASE]
	) and component_list = lazy !! (
		one_of ~name:"component_list" [
			"next_component", object_declaration >> semicolon >> component_list;
			"pragma_in_component_list", pragma >> component_list;
			"variant_part", r_CASE >> expression >> r_IS >> variant_record_alternatives >> semicolon;
			"null_component", r_NULL >> semicolon;
			"end_of_component", epsilon]
	) and record = lazy !! (
		one_of ~name:"record" [
			"null_record", r_NULL >> r_RECORD;
			"normal_record", r_RECORD >> component_list >> r_END >> r_RECORD]
	) and formals = lazy !! (
		one_of ~name:"formals" [
			"next_formal", object_declaration >> semicolon >> formals;
			"end_of_formal", object_declaration]
	) and formal_list = lazy !! (
		one_of ~name:"formals" [
			"no_formal", epsilon;
			"", l_paren >> formals >> r_paren]
	) and index_and_formal_list = lazy !! (
		one_of ~name:"index_and_formals" [
			"formals_only", formal_list;
			"has_index_range", l_paren >> r_FOR >> any_identifier >> r_IN >> subtype_definition >> r_paren >> formal_list;
			"has_index", l_paren >> expression >> r_paren >> formal_list]
	) and box_or_formal_list = lazy !! (
		one_of ~name:"formals" [
			"no_formal", epsilon;
			"boxed_formal", l_paren >> skip (element Box) >> r_paren;
			"", l_paren >> formals >> r_paren]
	) and type_names = lazy !! (
		one_of ~name:"type_names" [
			"next_type_name", any_identifier >> box_or_formal_list >> r_AND >> type_names; (* ex *)
			"end_of_type_name", any_identifier >> box_or_formal_list]
	) and type_declaration = lazy !! (
		one_of ~name:"type_declaration" [
			"type_forward", r_TYPE >> type_names;
			"type_body", r_TYPE >> any_identifier >> box_or_formal_list >> r_IS >> type_definition]
	) and subtype_declaration = lazy !! (
		sequence_of (r_SUBTYPE >> any_identifier >> r_IS >> subtype_definition)
	) and generic_formal_parameter_declaration = lazy !! (
		one_of ~name:"formal" [
			"formal_object", object_declaration;
			"formal_type", type_declaration;
			error "formal_subtype_error", subtype_declaration; (* better error handling *)
			"formal_procedure", r_WITH >> r_PROCEDURE >> any_name >> formal_list >> formal_subprogram_default_part;
			"formal_function", r_WITH >> r_FUNCTION >> any_name >> formal_list >> r_RETURN >> object_type >> formal_subprogram_default_part;
			"formal_package", r_WITH >> r_PACKAGE >> any_identifier >> r_IS >> r_NEW >> primary;
			"use_clause_in_formals", use_clause]
	) and formal_subprogram_default_part = lazy !! (
		one_of ~name:"formal_subprogram_default_part" [
			"formal_subprogram_spec", epsilon;
			"formal_subprogram_default", r_IS >> primary;
			"formal_subprogram_abstract", r_IS >> r_ABSTRACT;
			"formal_subprogram_inferable", r_IS >> skip (element Box)]
	) and generic_formal_parameter_declarations = lazy !! (
		one_of ~name:"generic_formal_parameter_declarations" [
			"next_generic_formal_parameter_declaration", generic_formal_parameter_declaration >> semicolon >> generic_formal_parameter_declarations;
			"end_of_generic_formal_parameter_declaration", epsilon]
	) and component_representations = lazy !! (
		one_of ~name:"component_representations" [
			"next_component_representation", any_identifier >> r_AT >> logical_expression >> r_RANGE >> discrete_subtype_definition >> semicolon >> component_representations;
			"end_of_component_representation", epsilon]
	) and at_mod_representation = lazy !! (
		one_of ~name:"at_mod_representation" [
			"has_at_mod", r_AT >> r_MOD >> expression >> semicolon;
			"no_at_mod", epsilon]
	) and representation = lazy !! (
		one_of ~name:"representation" [
			"record_representation", r_FOR >> primary >> r_USE >>
				r_RECORD >> at_mod_representation >> component_representations >> r_END >> r_RECORD;
			"address_representation", r_FOR >> primary >> r_USE >> r_AT >> expression;
			"other_representation", r_FOR >> primary >> r_USE >> expression]
	) and overriding = lazy !! (
		one_of ~name:"overriding" [
			"overriding", r_OVERRIDING;
			"overriding_intf", r_OVERRIDING >> l_paren >> primary >> r_paren; (* ex *)
			"not_overriding", r_NOT >> r_OVERRIDING]
	) and subprogram_declaration = lazy !! (
		one_of ~name:"declaration" [
			"procedure_declaration", procedure_declaration;
			"function_declaration", function_declaration]
	) and block_declaration = lazy !! (
		one_of ~name:"declaration" [
			"", subprogram_declaration;
			"package_declaration", package_declaration_with_private]
	) and generic = lazy !! (
		r_GENERIC >> error_pragma_list >> generic_formal_parameter_declarations >>
		one_of ~name:"declaration" [
			"", block_declaration;
			error "task_error", task_declaration; (* better error handling *)
			error "protected_error", protected_declaration] (* better error handling *)
	) and declaration = lazy !! (
		one_of ~name:"declaration" [
			"object_declaration", object_declaration;
			"simple_constant", identifiers >> skip (element EQ) >> expression; (* ex *)
			"type_declaration", type_declaration;
			"representation", representation;
			"subtype_declaration", subtype_declaration;
			"", block_declaration;
			"task_declaration", task_declaration;
			"protected_declaration", protected_declaration;
			"generic_declaration", generic;
			"overriding_declaration", overriding >> subprogram_declaration;
			"entry", entry;
			"use", use_clause]
	) and declarations = lazy !! (
		one_of ~name:"declarations" [
			"next_declaration", declaration >> semicolon >> declarations;
			"next_pragma_in_declarations", pragma >> declarations;
			"end_of_declaration", epsilon];
	(* types *)
	) and object_type_variable = lazy !! (
		one_of ~name:"object_type" [
			"constant", r_CONSTANT >> subtype_definition;
			"typeless_constant", r_CONSTANT;
			"variable", subtype_definition]
	) and object_type_aliased = lazy !! (
		one_of ~name:"object_type" [
			"aliased", r_ALIASED >> object_type_variable;
			"exception", r_EXCEPTION;
			"", object_type_variable]
	) and object_type = lazy !! (
		one_of ~name:"object_type" [
			"in", r_IN >> object_type_aliased;
			"out", r_OUT >> object_type_aliased;
			"in_out", r_IN >> r_OUT >> object_type_aliased;
			"", object_type_aliased]
	) and enum_item = lazy !! (
		one_of ~name:"enum_item" [
			"enum_item", any_enum_name;
			"enum_range", any_character_literal >> skip (element D_dot) >> any_character_literal] (* ex *)
	) and enum_items = lazy !! (
		one_of ~name:"enum_items" [
			"next_enum_item", enum_item >> skip (element Comma) >> enum_items;
			"end_of_enum_item", enum_item]
	) and inheritance = lazy !! (
		one_of ~name:"inheritance" [
			"next_inheritance", primary >> r_AND >> inheritance;
			"end_of_inheritance", primary]
	) and interface = lazy !! (
		sequence_of (r_INTERFACE >>
			one_of ~name:"inheritance" [
				"", r_AND >> inheritance;
				"no_inheritance", epsilon])
	) and indexes = lazy !! (
		one_of ~name:"indexes" [
			"next_index", subtype_definition >> skip (element Comma) >> indexes;
			"end_of_index", subtype_definition]
	) and array = lazy !! (
		sequence_of (r_ARRAY >> l_paren >> indexes >> r_paren >> r_OF >> object_type)
	) and access_type = lazy !! (
		one_of ~name:"access_type" [
			"access", r_ACCESS >> subtype_definition;
			"access_all", r_ACCESS >> r_ALL >> subtype_definition;
			"access_constant", r_ACCESS >> r_CONSTANT >> subtype_definition;
			"access_procedure", r_ACCESS >> r_PROCEDURE >> formal_list;
			"access_function", r_ACCESS >> r_FUNCTION >> formal_list >> r_RETURN >> object_type;
			"access_protected_procedure", r_ACCESS >> r_PROTECTED >> r_PROCEDURE >> formal_list;
			"access_protected_function", r_ACCESS >> r_PROTECTED >> r_FUNCTION >> formal_list >> r_RETURN >> object_type]
	) and box_definition = lazy !! (
		one_of ~name:"subtype_definition" [
			"box", position_of (element Box)]
	) and range_definition = lazy !! (
		one_of ~name:"subtype_definition" [
			"first_last", simple_expression >> position_of (element D_dot) >> simple_expression]
	) and discrete_subtype_definition = lazy !! (
		one_of ~name:"subtype_definition" [
			"mark", primary;
			"", box_definition;
			"", range_definition]
	) and constrained_type = lazy !! (
		one_of ~name:"subtype_definition" [
			"", range_definition;
			"range", primary >> r_RANGE >> discrete_subtype_definition;
			"digits", primary >> r_DIGITS >> logical_expression;
			"digits_range", primary >> r_DIGITS >> logical_expression >> r_RANGE >> discrete_subtype_definition;
			"delta", primary >> r_DELTA >> logical_expression;
			"delta_range", primary >> r_DELTA >> logical_expression >> r_RANGE >> discrete_subtype_definition;
			"delta_digits", primary >> r_DELTA >> logical_expression >> r_DIGITS;
			"delta_digits_range", primary >> r_DELTA >> logical_expression >> r_DIGITS >> logical_expression >> r_RANGE >> discrete_subtype_definition]
	) and subtype_with_constraint = lazy !! (
		one_of ~name:"subtype_definition" [
			"mark", primary;
			"", constrained_type]
	) and subtype_indiction_without_mark = lazy !! (
		one_of ~name:"subtype_definition" [
			"", constrained_type;
			"not_null", r_NOT >> r_NULL >> subtype_with_constraint]
	) and anonymous_type = lazy !! (
		one_of ~name:"subtype_definition" [
			"mark", primary;
			"", constrained_type;
			"anonymous_array", array;
			"anonymous_access", access_type]
	) and subtype_definition = lazy !! (
		one_of ~name:"subtype_definition" [
			"", anonymous_type;
			"not_null", r_NOT >> r_NULL >> anonymous_type]
	) and type_definition = lazy !! (
		one_of ~name:"type_definition" [
			"enum", l_paren >> enum_items >> r_paren;
			"generic_enum", l_paren >> skip (element Box) >> r_paren;
			"nullable_access_type", access_type;
			"not_null_access_type", r_NOT >> r_NULL >> access_type;
			"array", array;
			"modular", r_MOD >> box_expression;
			"integer", r_RANGE >> discrete_subtype_definition;
			"float", r_DIGITS >> box_expression;
			"float_range", r_DIGITS >> box_expression >> r_RANGE >> discrete_subtype_definition;
			"fixed", r_DELTA >> box_expression;
			"fixed_range", r_DELTA >> box_expression >> r_RANGE >> discrete_subtype_definition;
			"fixed_delta", r_DELTA >> box_expression >> r_DIGITS >> box_expression;
			"fixed_delta_range", r_DELTA >> box_expression >> r_DIGITS >> box_expression >> r_RANGE >> discrete_subtype_definition;
			"record", record;
			"private", r_PRIVATE;
			"limited_record", r_LIMITED >> record;
			"limited_private", r_LIMITED >> r_PRIVATE;
			"tagged_forward", r_TAGGED;
			"tagged_record", r_TAGGED >> record;
			"tagged_private", r_TAGGED >> r_PRIVATE;
			"tagged_limited_record", r_TAGGED >> r_LIMITED >> record;
			"tagged_limited_private", r_TAGGED >> r_LIMITED >> r_PRIVATE;
			"abstract_tagged_record", r_ABSTRACT >> r_TAGGED >> record;
			"abstract_tagged_private", r_ABSTRACT >> r_TAGGED >> r_PRIVATE;
			"abstract_tagged_limited_record", r_ABSTRACT >> r_TAGGED >> r_LIMITED >> record;
			"abstract_tagged_limited_private", r_ABSTRACT >> r_TAGGED >> r_LIMITED >> r_PRIVATE;
			"inheritance", r_NEW >> subtype_definition;
			"tagged_inheritance", r_NEW >> inheritance >> r_WITH >> record;
			"tagged_private_inheritance", r_NEW >> inheritance >> r_WITH >> r_PRIVATE;
			"abstract_tagged_inheritance", r_ABSTRACT >> r_NEW >> inheritance >> r_WITH >> record;
			"abstract_tagged_private_inheritance", r_ABSTRACT >> r_NEW >> inheritance >> r_WITH >> r_PRIVATE;
			"limited_tagged_inheritance", r_LIMITED >> r_NEW >> inheritance >> r_WITH >> record;
			"limited_tagged_private_inheritance", r_LIMITED >> r_NEW >> inheritance >> r_WITH >> r_PRIVATE;
			"synchronized_private_inheritance", r_SYNCHRONIZED >> r_NEW >> inheritance >> r_WITH >> r_PRIVATE;
			"interface", interface;
			"limited_interface", r_LIMITED >> interface;
			"task_interface", r_TASK >> interface;
			"protected_interface", r_PROTECTED >> interface;
			"synchronized_interface", r_SYNCHRONIZED >> interface]
	(* expressions *)
	) and argument_name = lazy !! (
		one_of ~name:"argument_name" [
			"expression_as_name", expression;
			"others", r_OTHERS]
	) and argument_names = lazy !! (
		one_of ~name:"argument_names" [
			"next_argument_name", argument_name >> skip (element Vertical) >> argument_names;
			"end_of_argument_name", argument_name]
	) and argument = lazy !! (
		one_of ~name:"expression" [
			"", expression;
			"named_argument", argument_names >> skip (element Arrow) >> expression]
	) and arguments = lazy !! (
		one_of ~name:"expression" [
			"", argument;
			"next_argument", argument >> skip (element Comma) >> arguments]
	) and aggregate = lazy !! (
		one_of ~name:"expression" [
			"", arguments;
			"extension", expression >> r_WITH >> arguments]
	) and primary = lazy !! (
		one_of ~name:"expression" [
			"literal", any_literal; (* character, string, integer, real literal *)
			"reference", any_identifier;
			"aggregate", l_paren >> aggregate >> r_paren;
			"qualified", primary >> skip (element Quote) >> l_paren >> aggregate >> r_paren;
			"function_call", primary >> l_paren >> arguments >> r_paren;
			"attribute", primary >> any_attribute;
			"compound", primary >> skip (element Period) >> any_name;
			"dereference", primary >> skip (element Period) >> r_ALL]
	) and prefixed = lazy !! (
		one_of ~name:"expression" [
			"", primary;
			"abs", r_ABS >> primary;
			"null", r_NULL;
			"with_null_record", r_NULL >> r_RECORD;
			"not", r_NOT >> primary;
			"statement_in_expression", statement_with_value; (* ex *)
			(* RM 4.8 "Allocators" allows "new subtype_indication",
			   but it occurs shift/reduce conflict.
			   For example "new integer range 1 .. 2 + 3" will be parsed
			   "new (integer range 1 .. 2 + 3)" and
			   "(new integer range 1 .. 2) + 3".
			   GNAT disallowed placing constraint in allocator. *)
			"new", r_NEW >> primary]
	) and factor = lazy !! (
		one_of ~name:"expression" [
			"", prefixed;
			"exponentiate", prefixed >> position_of (element Exponentiate) >> prefixed]
	) and term = lazy !! (
		one_of ~name:"expression" [
			"", factor;
			"mul", term >> position_of (element Asterisk) >> factor;
			"div", term >> position_of (element Slash) >> factor;
			"mod", term >> position_of (r_MOD) >> factor;
			"rem", term >> position_of (r_REM) >> factor]
	) and first_sum = lazy !! (
		one_of ~name:"expression" [
			"", term;
			"positive", position_of (element Plus) >> term;
			"negative", position_of (element Minus) >> term]
	) and sum = lazy !! (
		one_of ~name:"expression" [
			"", first_sum;
			"concatnate", sum >> position_of (element Ampersand) >> term;
			"add", sum >> position_of (element Plus) >> term;
			"sub", sum >> position_of (element Minus) >> term]
	) and simple_expression = lazy !! (
		sum
	) and relation_expression = lazy !! (
		one_of ~name:"expression" [
			"", simple_expression;
			"relation", simple_expression >> position_with (one_of_elements [EQ; LT; LE; GT; GE; NE]) >> simple_expression;
			"membership", simple_expression >> position_of (r_IN) >> discrete_subtype_definition;
			"not_membership", simple_expression >> position_of (r_NOT >> r_IN) >> discrete_subtype_definition]
	) and logical_expression = lazy !! (
		one_of ~name:"expression" [
			"", relation_expression;
			"and", logical_expression >> position_of (r_AND) >> relation_expression;
			"and_then", logical_expression >> position_of (r_AND >> r_THEN) >> relation_expression;
			"or", logical_expression >> position_of (r_OR) >> relation_expression;
			"or_else", logical_expression >> position_of (r_OR >> r_ELSE) >> relation_expression;
			"xor", logical_expression >> position_of (r_XOR) >> relation_expression]
	) and box_expression = lazy !! (
		one_of ~name:"expression" [
			"", logical_expression;
			"anonymous_type", box_definition]
	) and expression = lazy !! (
		one_of ~name:"expression" [
			"", box_expression;
			"anonymous_type", subtype_indiction_without_mark]
	(* statements *)
	) and block = lazy !! (
		sequence_of (r_BEGIN >> statements_with_value >> exception_handlers >> r_END)
	) and if_statement = lazy !! (
		r_IF >> expression >> r_THEN >> statements_with_value >> else_part >> r_END >> r_IF
	) and else_part = lazy !! (
		one_of ~name:"else_part" [
			"elsif", r_ELSIF >> expression >> r_THEN >> statements_with_value >> else_part;
			"else", r_ELSE >> statements_with_value >> error_else_part;
			"end_else", epsilon]
	) and error_else_part = lazy !! ( (* better error handling *)
		one_of ~name:"else_part" [
			error "elsif", r_ELSIF >> expression >> r_THEN >> statements_with_value >> error_else_part;
			error "else", r_ELSE >> statements_with_value >> error_else_part;
			"end_else", epsilon]
	) and case = lazy !! (
		r_CASE >> expression >> r_IS >> 
		error_pragma_list >> (* better error handling *)
		alternatives >> r_END >> r_CASE
	) and case_statement_alternative = lazy !! (
		r_WHEN >> patterns >> skip (element Arrow) >> statements_with_value
	) and alternatives = lazy !! (
		one_of ~name:"alternatives" [
			"next_case", case_statement_alternative >> alternatives;
			"end_of_case", epsilon]
	) and loop = lazy !! (
		sequence_of (r_LOOP >> statements >> r_END >> r_LOOP >> optional_name)
	) and for_loop = lazy !! (
		r_FOR >> any_identifier >> r_IN >> 
		one_of ~name:"direction" [
			"forward", subtype_definition;
			"reverse", r_REVERSE >> subtype_definition] >>
		loop
	) and while_loop = lazy !! (
		r_WHILE >> expression >> loop
	) and delay = lazy !! (
		sequence_of (
			r_DELAY >> one_of ~name:"delay" [
				"delay_for", expression;
				"delay_until", r_UNTIL >> expression])
	) and accept = lazy !! (
		sequence_of (
			r_ACCEPT >> any_identifier >> index_and_formal_list >>
			one_of ~name:"accept_block" [
				"has_accept_block", r_DO >> statements >> exception_handlers >> r_END >> optional_name;
				"no_accept_block", epsilon])
	) and exit = lazy !! (
		r_EXIT >> optional_label_name_ref >> condition
	) and return = lazy !! (
		r_RETURN >>  
		one_of ~name:"return_statement" [
			"procedure_return", epsilon;
			"simple_return", expression;
			"extended_return", any_identifier >> skip (element Colon) >> object_type >> object_initial >> 
				one_of ~name:"extended_return_block" [
					"return_without_block", epsilon;
					"return_with_block", r_DO >> statements >> exception_handlers >> r_END >> r_RETURN]]
	) and raise = lazy !! (
		r_RAISE >> 
		one_of ~name:"raise" [
			"first_raise", expression >>
				one_of ~name:"exception_info" [
					"no_info", epsilon;
					"message", r_WITH >> expression];
			"reraise", epsilon]
	) and select_event = lazy !! (
		sequence_of (
			one_of ~name:"select_event" [
				"entry_call", primary;
				"accept_event", accept;
				"delay_event", delay;
				"terminate_event", r_TERMINATE] >> 
			semicolon >>
			statements)
	) and select_condition = lazy !! (
		one_of ~name:"select_condition" [
			"select_always", select_event;
			"select_when", r_WHEN >> expression >> skip (element Arrow) >> select_event]
	) and select_events = lazy !! (
		one_of ~name:"select_events" [
			"next_select_event",  select_condition >> r_OR >> select_events;
			"end_of_select_event", select_condition]
	) and select = lazy !! (
		r_SELECT >> select_events >>
		one_of ~name:"select_option" [
			"no_select_option", epsilon;
			"select_then_abort", r_THEN >> r_ABORT >> statements;
			"select_else", r_ELSE >> statements] >>
		r_END >> r_SELECT
	) and abort = lazy !! (
		r_ABORT >> primary_list
	) and requeue = lazy !! (
		r_REQUEUE >> primary >>
		one_of ~name:"requeue" [
			"simple_requeue", epsilon;
			"with_abort", r_WITH >> r_ABORT]
	) and statement_with_value = lazy !! (
		one_of ~name:"statement" [
			"if", if_statement;
			"case", case;
			"block", block >> optional_name;
			"declare_block", r_DECLARE >> declarations >> block >> optional_name]
	) and statement = lazy !! (
		one_of ~name:"statement" [
			"null_statement", r_NULL;
			"assignment", primary >> skip (element Assign) >> expression;
			"procedure_call", primary;
			"", statement_with_value;
			"loop", loop;
			"for", for_loop;
			"while", while_loop;
			"exit", exit;
			"return", return;
			"goto", r_GOTO >> label_name_ref;
			"raise", raise;
			"abort", abort;
			"requeue", requeue;
			"delay", delay;
			"accept", accept;
			"select", select;
			"named_statement", any_identifier >> skip (element Colon) >> statement;
			"labeled_statement", skip (element L_label) >> any_identifier >> skip (element R_label) >> statement]
	) and statements = lazy !! (
		one_of ~name:"statements" [
			"next_statement", statement >> semicolon >> statements;
			"next_pragma_in_statements", pragma >> statements;
			"end_of_statement", epsilon]
	) and statements_with_value = lazy !! (
		one_of ~name:"statements" [
			"next_statement", statement >> semicolon >> statements_with_value;
			"next_pragma_in_statements", pragma >> statements_with_value;
			"end_of_statement_with_value", expression; (* ex *)
			"end_of_statement", epsilon]
	) and exception_handlers = lazy !! (
		one_of ~name:"exception_handlers" [
			"has_handlers",
				r_EXCEPTION >> 
				error_pragma_list >> (* better error handling *)
				alternatives;
			"no_handlers", epsilon] >>
		one_of ~name:"terminate_handlers" ["finally", r_TERMINATE >> statements; "no_finally", epsilon] >> (* ex *)
		one_of ~name:"where" ["body", r_BODY >> declarations; "no_where", epsilon] (* ex *)
	(* pragmas *)
	) and pragma = lazy !! (
		sequence_of (
			any_pragma >> 
			one_of ~name:"pragma_arguments" [
				"pragma_without_arguments", epsilon;
				"pragma_with_arguments", l_paren >> arguments >> r_paren] >>
			semicolon)
	) and pragma_list = lazy !! (
		one_of ~name:"pragma_list" [
			"next_pragma", pragma >> pragma_list;
			"end_of_pragma", pragma]
	) and error_pragma_list = lazy !! (
		one_of ~name:"error_pragma_list" [
			error "pragma_error", pragma_list;
			"no_pragma", epsilon]
	(* names *)
	) and optional_name = lazy !! (
		one_of ~name:"name" [
			"identifier_name", any_identifier;
			"no_name", epsilon]
	) and package_name = lazy !! ( (* package XXX *)
		one_of ~name:"name" [
			"identifier_name", any_identifier;
			"child_name", package_name >> skip (element Period) >> any_identifier]
	) and optional_package_name = lazy !! ( (* end XXX *)
		one_of ~name:"name" [
			"", package_name;
			"no_name", epsilon]
	) and subprogram_name = lazy !! ( (* procedure XXX *)
		one_of ~name:"name" [
			"identifier_name", any_name;
			"attribute_name", any_identifier >> any_attribute; (* ex *)
			"child_name", package_name >> skip (element Period) >> any_name]
	) and optional_subprogram_name = lazy !! ( (* end XXX *)
		one_of ~name:"name" [
			"", subprogram_name;
			"no_name", epsilon]
	) and package_name_ref = lazy !! ( (* use XXX *)
		package_name
	) and label_name_ref = lazy !! ( (* goto XXX *)
		package_name
	) and optional_label_name_ref = lazy !! ( (* exit XXX *)
		optional_package_name
	);;

end;;
